home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / getnews.tcl.z / getnews.tcl
Text File  |  2002-07-08  |  8KB  |  320 lines
  1. #
  2. # getnews.tcl  -  NNTP retrieve client for exmh
  3. # Needs tcl7.5/tk4.1 or above.
  4. # 
  5. # Chris Keane (Chris.Keane@comlab.ox.ac.uk)
  6. # 26-Feb-97
  7.  
  8.  
  9. proc GetNews {} {
  10.  
  11.     global NNTP
  12.  
  13.     if {![llength $NNTP(groups)]} {
  14.     Exmh_Status "No groups specified to retrieve"
  15.     return
  16.     }
  17.  
  18.     BgAction "News" GetNewsBg
  19. }
  20.  
  21. proc GetNewsBg {} {
  22.     busy Exmh_Status "Retrieve news: [GetNewsInt]"
  23. }
  24.  
  25. proc GetNewsInt {} {
  26.  
  27.     global NNTP mhProfile env
  28.  
  29.     if {![llength $NNTP(newsrc)]} {
  30.     set newsrc {~/.newsrc}
  31.     } else {
  32.     set newsrc $NNTP(newsrc)
  33.     }
  34.  
  35.     if {[file exists $newsrc]} {
  36.     if {[catch {open $newsrc} rcfile]} {
  37.         return "cannot open file $newsrc\n$rcfile"
  38.     }
  39.     } else {
  40.     set rcfile {}
  41.     }
  42.     Exmh_Status "Connecting to server $NNTP(host)..."
  43.     if {[catch {socket $NNTP(host) $NNTP(port)} nntpskt]} {
  44.     if {[string length $rcfile]} {
  45.         close $rcfile
  46.     }
  47.     return $nntpskt
  48.     }
  49.  
  50.     set line [NNTPReply $nntpskt]
  51.     if {[string first 200 $line] && [string first 201 $line]} {
  52.     NNTPClose $nntpskt $rcfile
  53.     return $line
  54.     }
  55.  
  56.     # Open the .newsrc file and extract the lines relating to the groups
  57.     # we're going to retrieve
  58.  
  59.     set gcount 0
  60.     set grps $NNTP(groups)
  61.     while {[string length $rcfile] && [llength $grps] && [gets $rcfile line] != -1} {
  62.     if {![regexp {^([0-9A-Za-z+&-\._]+)[:!][     ]*([0-9,-]+)} $line match group articles]} {
  63.         continue
  64.     }
  65.     set indx [lsearch -exact $grps $group]
  66.     if {$indx != -1} {
  67.         set thegrps($gcount) $group
  68.         set thearts($gcount) $articles
  69.         incr gcount
  70.         set grps [lreplace $grps $indx $indx]
  71.     }
  72.     }
  73.  
  74.     # If there are any groups which weren't in the .newsrc file, set their
  75.     # "articles which have been read" list to {}
  76.     foreach group $grps {
  77.     set thegrps($gcount) $group
  78.     set thearts($gcount) {}
  79.     incr gcount
  80.     }
  81.  
  82.     # make a temp directory for putting articles in while we work
  83.     if {![file isdirectory $mhProfile(path)/MyIncTmp]} {
  84.     exec mkdir $mhProfile(path)/MyIncTmp
  85.     }
  86.  
  87.     # Now get the articles from the server
  88.     set thisg 0
  89.     set acount 0
  90.     set ecount [file tail [Mh_Path MyIncTmp new]]
  91.     Exmh_Status "Retrieving articles..."
  92.     while {$thisg < $gcount} {
  93.     NNTPCommand $nntpskt "GROUP $thegrps($thisg)"
  94.     set line [NNTPReply $nntpskt]
  95.     if ![string first 480 $line] {
  96.         set ok [NNTPAuthenticate $nntpskt]
  97.         if $ok {
  98.         NNTPCommand $nntpskt "GROUP $thegrps($thisg)"
  99.         set line [NNTPReply $nntpskt]
  100.         }
  101.     }    
  102.     if {[string first 211 $line]} {
  103.         Exmh_Status "Cannot select newsgroup $thegrps($thisg)"
  104.         Exmh_Debug "Line: $line"
  105.         set thearts($thisg) "X"
  106.         incr thisg
  107.         continue
  108.     }
  109.  
  110.     if {![regexp {^211 ([0-9]+) ([0-9]+) ([0-9]+)} $line match num first last]} {
  111.         NNTPClose $nntpskt $rcfile
  112.         return "cannot parse server response"
  113.     }
  114.  
  115.     if {$num == 0} {
  116.         incr thisg
  117.         continue
  118.     }
  119.  
  120.     # start reading at the next unread article in this group
  121.     if {[regexp {^([0-9]+[,-])*([0-9]+)$} $thearts($thisg) match num tlast]
  122.         && $tlast >= $first} {
  123.         set first [expr $tlast + 1]
  124.     }
  125.  
  126.     set line 423
  127.     while {![string first 423 $line] || ![string first 430 $line]} {
  128.         if {$first > $last} {
  129.         break
  130.         }
  131.         NNTPCommand $nntpskt "STAT $first"
  132.         set line [NNTPReply $nntpskt]
  133.         if {![string first 223 $line]} {
  134.         break
  135.         }
  136.         if {[string first 423 $line] && [string first 430 $line]} {
  137.         NNTPClose $nntpskt $rcfile
  138.         return $line
  139.         }
  140.         incr first
  141.     }
  142.  
  143.     # if we get a 423 or 430 back, there were no further articles anyway
  144.     if {![string first 423 $line] || ![string first 430 $line]} {
  145.         incr thisg
  146.         continue
  147.     }
  148.  
  149.     # otherwise we must have got a 223, i.e. the article is selected
  150.     Exmh_Status "Reading group $thegrps($thisg) (max [expr $last-$first+1] articles)..."
  151.     while {![string first 223 $line]} {
  152.         NNTPCommand $nntpskt "ARTICLE"
  153.         set line [NNTPReply $nntpskt]
  154.         if {[string first 220 $line]} {
  155.         NNTPClose $nntpskt $rcfile
  156.         return "unexpected server response"
  157.         }
  158.         if {![regexp {^220 ([0-9]+)} $line match anum]} {
  159.         NNTPClose $nntpskt $rcfile
  160.         return "cannot parse server response"
  161.         }
  162.         if {[catch {open $mhProfile(path)/MyIncTmp/[expr $ecount+$acount] {WRONLY CREAT EXCL}} afile]} {
  163.         NNTPClose $nntpskt $rcfile
  164.         return "cannot write temp article file\n$afile"
  165.         }
  166.         set line [gets $nntpskt]
  167.         while {![regexp {^\.$} $line]} {
  168.         # two leading .'s should be compressed into one
  169.         regexp {^\.(\..*)} $line match line
  170.         puts $afile $line
  171.         set line [gets $nntpskt]
  172.         }
  173.         close $afile
  174.  
  175.         NNTPCommand $nntpskt "NEXT"
  176.         set line [NNTPReply $nntpskt]
  177.         if {[string first 223 $line] && [string first 421 $line]} {
  178.         NNTPClose $nntpskt $rcfile
  179.         return $line
  180.         }
  181.         incr acount
  182.     }
  183.     # update the article references for the new .newsrc file
  184.     set thearts($thisg) [AL_Update $thearts($thisg) $anum]
  185.     incr thisg
  186.     }
  187.  
  188.     if {$acount} {
  189.     Inc_Presort 0
  190.     Exmh_Status "Writing .newsrc file..."
  191.     if {[string length $rcfile]} {
  192.         seek $rcfile 0
  193.         set oldrc [glob $newsrc]
  194.         set newsrc $newsrc.exmh
  195.     }
  196.     if {[catch {open $newsrc w} nrcfile]} {
  197.         NNTPClose $nntpskt $rcfile
  198.         return "cannot write new .newsrc file\n$nrcfile"
  199.     }
  200.  
  201.     # re-parse the old .newsrc file, replacing the relevant article numbers
  202.     # with their new values
  203.  
  204.     set thisg 0
  205.     while {[string length $rcfile] && [gets $rcfile line] != -1} {
  206.         if {$thisg >= $gcount || ![regexp {^([0-9A-Za-z+&-\._]+)([:!][     ]*)([0-9]+[,-])*[0-9]+$} $line match group chaff first] || [string compare $group $thegrps($thisg)]} {
  207.         puts $nrcfile $line
  208.         continue
  209.         }
  210.         if {[string match X $thearts($thisg)]} {
  211.         # we didn't manage to select this group
  212.         puts $nrcfile $line
  213.         } else {
  214.         puts $nrcfile "$group$chaff$thearts($thisg)"
  215.         }
  216.         incr thisg
  217.     }
  218.     while {$thisg < $gcount} {
  219.         if {![string match X $thearts($thisg)]} {
  220.         puts $nrcfile "$thegrps($thisg): $thearts($thisg)"
  221.         }
  222.         incr thisg
  223.     }
  224.     } else {
  225.     set nrcfile {}
  226.     }
  227.  
  228.     NNTPClose $nntpskt [list $rcfile $nrcfile]
  229.     if {[string length $rcfile] && [string length $nrcfile] && [catch {
  230.         exec mv -f $oldrc $oldrc.old
  231.         exec mv -f [glob $newsrc] $oldrc
  232.         } err]} {
  233.     return "failed to rename .newsrc files\n$err"
  234.     }
  235.     return "$acount new articles retrieved"
  236. }
  237.  
  238. # parse the existing .newsrc entry and update it with new values
  239. proc AL_Update {rcentry next} {
  240.  
  241.     # a few different cases here; first, if the existing entry is empty
  242.     if {![string length $rcentry]} {
  243.     set rcentry 1
  244.     }
  245.  
  246.     # if the last part of the existing entry is a single number
  247.     if {[regexp {^([0-9]+(-[0-9]+)?,)*([0-9]+)$} $rcentry match fst snd last]} {
  248.     if {$next == $last} {
  249.         return $rcentry
  250.     } else {
  251.         return "$rcentry-$next"
  252.     }
  253.  
  254.     # otherwise the last part of the existing entry must be a range mmm-nnn
  255.     } else {
  256.     regexp {^(([0-9]+(-[0-9]+)?,)*[0-9]+-)([0-9]+)$} $rcentry match fst snd thd last
  257.     if {$next == $last} {
  258.         # this case shouldn't actually ever happen, but just in case... 8-)
  259.         return $rcentry
  260.     } else {
  261.         return "$fst$next"
  262.     }
  263.     }
  264. }
  265.  
  266. proc NNTPCommand {nntpskt cmd} {
  267.     puts $nntpskt $cmd
  268.     regsub {pass.*$} $cmd {pass *****} cmd
  269.     Exmh_Debug NNTPCommand: $cmd
  270.     flush $nntpskt
  271. }
  272.  
  273. proc NNTPReply {nntpskt} {
  274.     set line [gets $nntpskt]
  275.     Exmh_Debug NNTPReply: $line
  276.     return $line
  277. }
  278.  
  279. proc NNTPClose {nntpskt rcfiles} {
  280.     global mhProfile
  281.  
  282.     puts $nntpskt QUIT
  283.     close $nntpskt
  284.     foreach rcf $rcfiles {
  285.     if {[string length $rcf]} {
  286.         close $rcf
  287.     }
  288.     }
  289.     File_Delete $mhProfile(path)/MyIncTmp/$mhProfile(mh-sequences)
  290.     catch {exec rmdir $mhProfile(path)/MyIncTmp}
  291. }
  292.  
  293. #
  294. # 'Original' AUTHINFO implementation
  295. # i.e., not AUTHINFO SIMPLE or AUTHINFO GENERIC
  296. # see 'Common NNTP extensions'
  297. #
  298. proc NNTPAuthenticate {sock} {
  299.  
  300.     global NNTP
  301.  
  302.     if {$NNTP(user)==""} {
  303.     tk_messageBox -message {News server requires authentication.
  304.         Check username and password in NNTP preferences} -type ok
  305.     return 0
  306.     }
  307.  
  308.     NNTPCommand $sock "authinfo user $NNTP(user)"
  309.     set line [NNTPReply $sock]
  310.     NNTPCommand $sock "authinfo pass $NNTP(pass)"
  311.     set line [NNTPReply $sock]
  312.     if [string first 281 $line] {
  313.     tk_messageBox -message {Authentication to NNTP server failed.
  314.         Check username and password in NNTP preferences} -type ok
  315.     return 0
  316.     } else {
  317.     return 1
  318.     }
  319. }
  320.